# $Id: tempfile.tcl 7557b5d4d82b 2012/12/02 09:07:16 pgurumur $
# Copyright (c) 2009 Prabhu Gurumurthy  <pgurumur@gmail.com>
# 
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#

# version "$Revision: 7557b5d4d82b $"
# author "$Author: pgurumur $"

lappend ::auto_path .
package require stdlib

namespace eval tempfile {
   namespace export create
   namespace export destroy
   namespace export basename
   set version 1.0
   set progname ""
}

proc tempfile::basename { program } {
   global progname
   if {[string length $program] > 0 } {
      set progname $program
   }
}


proc tempfile::_error mesg {
   global progname
   if {[string length $mesg] > 0} {
      if {[string length $progname] > 0 } {
         puts "$progname: $mesg"
      } else {
         puts $mesg
      }
   }

   exit 1
}

proc tempfile::create { directory }  {
   set tempfile ""
   set tmpdir ""

   if {[string length $directory] <= 0} {
      set tmpdir "/tmp"
   } else {
      set tmpdir $directory
   }

   set tmpfile "temp."
   set randchar [stdlib::randstring 6]
   append tmpfile $randchar
   set tempfile [file join $tmpdir $tmpfile]
   set fh ""
   if {[catch {set fh [open $tempfile "w"]} err ]} {
      tempfile::_error $err
   }

   if {[catch {close $fh} err]} {
      tempfile::_error $err
   }

   return $tempfile
}

proc tempfile::destroy { tempfile } {
   if {[string length $tempfile] > 0} {
      if {[file isfile $tempfile]} {
         if {[catch {file delete $tempfile} err]} {
            tempfile::_error $err
         }
      } else {
         tempfile::_error "$tempfile is not a file"
      }
   } else {
      tempfile::_error "No tempfile given"
   }
}

proc tempfile::? {} { lsort [info procs ::tempfile::*] }
package provide tempfile $tempfile::version
